## 'data.frame': 6497 obs. of 13 variables:
## $ fixedacidity : num 6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
## $ volatileacidity : num 0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
## $ citricacid : num 0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
## $ residualsugar : num 7.7 1.6 2.2 4.8 18.8 ...
## $ chlorides : num 0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
## $ freesulfurdioxide : num 36 29 18 30 65 16 4 34 46 58 ...
## $ totalsulfurdioxide: num 135 114 40 113 224 49 8 102 113 184 ...
## $ density : num 0.994 0.99 0.998 0.994 1 ...
## $ pH : num 3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
## $ sulphates : num 0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
## $ alcohol : num 10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
## $ quality : int 5 6 6 6 5 5 4 6 7 6 ...
## $ Vinho : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...
A base possui 6497 amostras com as seguintes variáveis:
Fixed Acidity: Acidez contida no vinho
Volatile Acidity: Quantidade de ácido acético no vinho, valores altos podem levar o vinho a ter sabor desagradável de vinagre
Citric Acid: Encontrado em pouca quantidade, o ácido cítrico pode adicionar frescor e sabor ao vinho.
Residual Sugar: Quantidade de açucar restante após o término da fermentação. É raro encontrar vinhos com menos de 1 g/l e vinhos com valores maiores que 45 g/l são considerardos doces.
Chlorides: Quantidade de sal no vinho
Free Sulfur Dioxide: A forma livre de SO2 (dióxido de enxofre) existe em equilibrio entre SO2 molecular (como um gás dissolvido) e ions bissulfito. Evita o crescimento de micróbios e oxidação do vinho.
Total Sulfur Dioxide: Total de SO2 livres ou ligados. Em baixa concentração, o SO2 é praticamente imperceptível no vinho, mas em concentrações acima de 50 ppm, o dióxido de enxofre torna-se evidente no aroma e sabor do vinho
Density: A densidade do vinho depende do percentual de álcool e açúcar.
pH: Descreve se o vinho é básico (14) ou ácido (0). A maioria dos vinhos possuem pH entre 3 e 4
Sulphates: Aditivo que pode contribuir com os níveis de SO2, que age contra micróbios e oxidação
Alcohol: O percentual de álcool no vinho
Quality: Qualidade do vinho com pontuação de 0 a 10, sendo 10 muito bom e 0 de péssima qualidade
Vinho: Tipo do vinho: tinto (RED) ou branco (WHITE)
## fixedacidity volatileacidity citricacid residualsugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.60
## 1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.80
## Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.00
## Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.44
## 3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.10
## Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :45.80
## chlorides freesulfurdioxide totalsulfurdioxide density
## Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
## 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
## Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
## Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
## 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
## Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0140
## pH sulphates alcohol quality
## Min. :2.720 Min. :0.2200 Min. : 0.9567 Min. :3.000
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.5000 1st Qu.:5.000
## Median :3.210 Median :0.5100 Median :10.3000 Median :6.000
## Mean :3.219 Mean :0.5313 Mean :10.4862 Mean :5.818
## 3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.3000 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.9000 Max. :9.000
## Vinho
## RED :1599
## WHITE:4898
##
##
##
##
Analisando o sumário, nota-se potenciais outliers dados que os valores mínimos e máximos estão muito distantes dos quartis para as seguintes variáveis: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, sulphates e alcohol
Além disso, há valores muito discrepantes:
Citric Acid com valor mínimo 0
Total Sulfur Dioxide com valor mínimo 6
Alcohol com valor mínimo 0,9667
##
## RED WHITE
## 3 10 20
## 4 53 163
## 5 681 1457
## 6 638 2198
## 7 199 880
## 8 18 175
## 9 0 5
Analisando a quantidade de vinhos por tipo e por qualidade, há mais vinhos do tipo branco do que tinto no data set. Também nota-se que ambos vinhos seguem uma tendência normal com relação à qualidade.
Comparando-se os atributos dos vinhos tintos com os vinhos brancos de forma tabular através da observação dos parâmetros de máximo, mínimo, média, desvio padrão e mediana da amostra. Temos:
Antes de qualquer conclusão, deve-se tratar as questões do outliers e valores faltantes que podem estar influenciando esta amostra.
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 6497
##
##
## | Vinhos$Vinho
## Vinhos$fx_redSugar | RED | WHITE | Row Total |
## -------------------|-----------|-----------|-----------|
## (0,10] | 1588 | 3705 | 5293 |
## | 62.493 | 20.401 | |
## | 0.300 | 0.700 | 0.815 |
## | 0.993 | 0.756 | |
## | 0.244 | 0.570 | |
## -------------------|-----------|-----------|-----------|
## (10,20] | 11 | 1175 | 1186 |
## | 270.305 | 88.244 | |
## | 0.009 | 0.991 | 0.183 |
## | 0.007 | 0.240 | |
## | 0.002 | 0.181 | |
## -------------------|-----------|-----------|-----------|
## (20,30] | 0 | 15 | 15 |
## | 3.692 | 1.205 | |
## | 0.000 | 1.000 | 0.002 |
## | 0.000 | 0.003 | |
## | 0.000 | 0.002 | |
## -------------------|-----------|-----------|-----------|
## (30,45.8] | 0 | 3 | 3 |
## | 0.738 | 0.241 | |
## | 0.000 | 1.000 | 0.000 |
## | 0.000 | 0.001 | |
## | 0.000 | 0.000 | |
## -------------------|-----------|-----------|-----------|
## Column Total | 1599 | 4898 | 6497 |
## | 0.246 | 0.754 | |
## -------------------|-----------|-----------|-----------|
##
##
Através da análise acima, pode-se verificar que que a quantidade de açúcar restante nos vinhos tintos é muito menor, sendo que 99,3% destes vinhos tem até 10 g/l e apenas 0,7% possuem quantidade até 20g/l. No caso dos vinhos brancos, percebe-se 75,6% possuem até 10g/l de quantidade de açúcar restante, 24% até 20g/l, 0,3% até 30g/l e 0,1% até 45.8g/l
Por esta tabela, pode-se deduzir que os vinhos brancos são normalmente percebidos como mais doces que os vinhos tintos.
Pelos resultados observados de forma tabular, temos que apenas o atributo citricacid possui valores zerados.
Abaixo são listados as amostras com ácido cítrico zerado:
## [1] 7 17 29 32 35 55 74 155 182 189 235 284 295 308
## [15] 328 336 436 470 618 628 824 882 884 918 979 1012 1061 1079
## [29] 1141 1187 1212 1222 1237 1244 1425 1608 1699 1700 1757 1812 1834 1836
## [43] 1850 1875 1895 1898 1906 1956 2239 2315 2402 2442 2451 2471 2489 2566
## [57] 2578 2652 2668 2724 2843 2878 2902 2906 2921 2966 3002 3078 3117 3220
## [71] 3261 3262 3300 3322 3441 3456 3469 3481 3507 3508 3596 3744 3799 3847
## [85] 3940 3973 3980 4036 4071 4129 4152 4200 4208 4216 4272 4282 4289 4321
## [99] 4394 4397 4512 4517 4534 4547 4549 4604 4704 4712 4768 4769 4814 4864
## [113] 4884 4947 4980 5048 5063 5079 5088 5108 5198 5301 5368 5389 5395 5406
## [127] 5432 5468 5497 5518 5538 5552 5594 5634 5651 5752 5778 5800 5813 5861
## [141] 5881 6013 6029 6077 6109 6256 6309 6394 6436 6451 6458
Conforme pesquisado na Internet (https://vinosdiferentes.com/pt/acidez-do-vinho/) , sabemos que o valor do ácido cítrico deve variar entre 0.1 e 1. Deste modo, muito provavelmente, o valor zerado deve ocorrer por imprecisão dos aparelhos de medição da concentração de ácido cítrico. Fazemos a sua substituição pelo valor mínimo (0.1)
#Segundo o site https://vinosdiferentes.com/pt/acidez-do-vinho/
#O valor do ácido cítrico é bem baixo, entre 0,1 e 1 g / litro
#Esse valor zerado pode ter sido a imprecisão dos aparelhos de medição
#Vamos trocá-los por 0.1 que é o valor mais provável
Vinhos[vinhosComZero,"citricacid"] <- 0.1
Quanto a existência de valores inválidos ou não inexistentes, isto não foi detectado na amostra.
#Verifica se há valores faltantes no dataset
nVinhosComValoresFaltantes <- length(Vinhos[is.na(Vinhos)]) + length(Vinhos[is.nan(as.matrix(Vinhos))])
paste0("Vinhos com valores faltantes = ",nVinhosComValoresFaltantes)
## [1] "Vinhos com valores faltantes = 0"
Quando realizamos a quebra pelo tipo de vinho em boxplotes, percebemos as seguintes características:
fixedacidity - O vinho tinto possui potenciais outliers apenas acima da barreira enquanto o branco possui acima e abaixo das barreiras
citricacid - Há mais potenciais outliers para vinho branco e eles aparecem tanto acima como abaixo das barreiras
residual sugar - Para vinho tinto há mais potenciais outliers. Para vinho branco há menos, mas ficam mais distantes da barreira superior
freesulfurdioxide - Há mais potenciais outliers para o vinho branco e se localizam mais distantes da barreira superior.
totalsufurdioxide - Há potenciais outliers tanto abaixo como acima das barreira para vinhos brancos, para tinto apenas acima e mais próximos
density - Para tinto há um número maior de potenciais outliers, tanto abaixo como acima das barreiras, para branco há poucos e alguns bem distantes
sulphates - Para tinto há mais potenciais outliers e mais distantes da barreira superior
alcohol - Há potenciais outliers acima e abaixo das barreiras apenas para vinhos tintos.
Dividiu-se a amostra entre Vinhos Tintos e Vinhos Brancos
A partir dessa divisão, traçaram-se lado a lado os histogramas dessa subdivisão e percebe-se que o histograma é bem diferente para cada atributo e cada tipo de vinho (tinto e branco)
A percepção visual será complementada com os testes T das médias dos atributos numéricos para a comprovação das diferenças.
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo fixedacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 32.423, df = 1848.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.376241 1.553458
## sample estimates:
## mean of x mean of y
## 8.319637 6.854788
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo volatileacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 53.059, df = 1938.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.2403544 0.2588044
## sample estimates:
## mean of x mean of y
## 0.5278205 0.2782411
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo citricacid"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -11.216, df = 2055.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.06502621 -0.04567110
## sample estimates:
## mean of x mean of y
## 0.2792308 0.3345794
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo residualsugar"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -48.057, df = 6401, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.005513 -3.691539
## sample estimates:
## mean of x mean of y
## 2.538806 6.387332
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo chlorides"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 34.24, df = 1827.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.03930596 0.04408241
## sample estimates:
## mean of x mean of y
## 0.08746654 0.04577236
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo freesulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -54.428, df = 4461.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -20.13315 -18.73318
## sample estimates:
## mean of x mean of y
## 15.87492 35.30808
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo totalsulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -89.872, df = 3477, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -93.89760 -89.88813
## sample estimates:
## mean of x mean of y
## 46.46779 138.36066
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo density"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 43.15, df = 4252.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.002600624 0.002848190
## sample estimates:
## mean of x mean of y
## 0.9967467 0.9940223
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo pH"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 27.775, df = 2667.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.1141740 0.1315191
## sample estimates:
## mean of x mean of y
## 3.311113 3.188267
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo sulphates"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 37.056, df = 2091, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.159395 0.177209
## sample estimates:
## mean of x mean of y
## 0.6581488 0.4898469
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo alcohol"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -3.3571, df = 2852.3, p-value = 0.0007979
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.18088842 -0.04749554
## sample estimates:
## mean of x mean of y
## 10.40008 10.51427
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo quality"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -10.149, df = 2950.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2886173 -0.1951564
## sample estimates:
## mean of x mean of y
## 5.636023 5.877909
Realizados os testes T para as amostras separadas de vinhos tintos e brancos, observam-se os fatos descritos abaixo: * Para cada atributo numérico dos vinhos brancos e tintos realizou-se um teste T * Os testes foram parametrizados com um nível de confiança de 95% * O p-value de cada um dos testes apresentou valores substancialmente menores que 5%.
Deste modo, para o modelo preditivo a ser desenvolvido, a partir deste ponto, iremos separar a amostras entre os dois tipos de vinho (tinto,branco) e prosseguiremos na criação do modelo preditivo da qualidade apenas para os vinhos brancos
## [1] "Potenciais outliers referentes ao atributo fixedacidity"
## [1] "Quantidade de potenciais outliers 119"
## [1] ""
## [1] 9.3 9.1 9.2 9.2 9.2 9.3 9.2 9.8 8.9 9.2 9.2 4.2 9.8 10.3
## [15] 10.2 9.8 9.0 10.0 8.9 8.9 9.2 9.0 10.0 9.0 9.2 9.8 9.0 4.7
## [29] 8.9 4.7 10.7 8.9 9.6 9.2 8.9 8.9 9.0 9.1 9.8 9.2 9.4 9.0
## [43] 9.6 9.0 9.2 9.6 9.3 9.8 9.2 9.0 9.9 4.7 4.4 9.6 8.9 9.8
## [57] 9.9 8.9 9.4 9.2 8.9 10.0 9.0 4.6 9.0 3.8 9.0 9.2 9.0 9.7
## [71] 9.2 9.7 11.8 9.7 14.2 8.9 8.9 9.7 4.7 9.4 9.5 9.4 9.1 9.4
## [85] 9.0 9.0 9.4 9.6 9.0 9.2 10.7 9.8 9.1 10.3 3.9 9.2 4.4 8.9
## [99] 9.4 9.0 9.2 4.4 8.9 4.2 9.5 9.0 9.4 4.7 9.2 9.2 9.1 9.4
## [113] 9.4 4.5 8.9 8.9 9.1 9.2 9.4
## [1] ""
## [1] "Potenciais outliers referentes ao atributo volatileacidity"
## [1] "Quantidade de potenciais outliers 186"
## [1] ""
## [1] 0.580 0.560 0.510 0.520 0.695 0.670 0.550 0.610 0.640 0.710 0.640
## [12] 0.555 0.540 0.570 0.510 0.520 0.660 0.610 0.595 0.520 0.620 0.580
## [23] 0.490 0.530 0.550 0.520 0.590 0.570 0.510 0.490 0.550 0.560 0.540
## [34] 0.590 0.910 0.660 0.510 0.550 0.640 0.690 0.670 0.510 0.490 0.540
## [45] 0.690 0.580 0.555 0.580 0.600 0.545 0.500 0.610 0.670 0.815 0.650
## [56] 0.530 0.540 0.655 0.600 0.520 0.550 0.560 0.670 0.655 0.500 0.520
## [67] 0.680 0.615 0.490 0.560 0.550 0.490 0.930 0.490 0.685 0.520 0.530
## [78] 0.550 0.760 0.640 0.490 0.560 0.600 0.510 0.580 0.640 0.620 1.005
## [89] 0.560 0.965 0.520 0.500 0.520 0.490 0.560 0.540 0.500 0.530 0.520
## [100] 0.640 0.640 0.600 0.530 0.490 0.530 0.695 0.560 0.610 0.500 0.500
## [111] 0.730 0.500 0.510 0.660 0.600 0.670 0.580 0.780 0.680 0.630 0.615
## [122] 0.530 0.615 0.620 0.500 0.570 0.540 0.490 0.550 0.550 0.500 0.530
## [133] 0.550 0.785 0.570 1.100 0.705 0.600 0.850 0.510 0.500 0.600 0.495
## [144] 0.620 0.660 0.750 0.540 0.905 0.490 0.550 0.510 0.655 0.585 0.705
## [155] 0.680 0.580 0.500 0.540 0.595 0.610 0.540 0.500 0.650 0.610 0.615
## [166] 0.740 0.610 0.495 0.550 0.585 0.590 0.760 0.490 0.510 0.695 0.500
## [177] 0.620 0.540 0.550 0.490 0.630 0.590 0.550 0.490 0.560 0.500
## [1] ""
## [1] "Potenciais outliers referentes ao atributo citricacid"
## [1] "Quantidade de potenciais outliers 251"
## [1] ""
## [1] 0.07 1.00 0.74 0.07 0.09 0.62 0.04 0.07 0.06 0.68 0.59 0.04 0.01 0.07
## [15] 0.71 0.74 0.67 0.02 0.04 0.74 1.00 0.61 0.59 0.64 0.74 0.70 0.58 0.62
## [29] 0.66 0.71 0.88 0.68 0.74 0.04 0.64 0.65 0.01 0.67 0.58 0.62 0.62 0.67
## [43] 0.58 0.72 0.91 0.62 0.71 0.05 0.74 0.58 0.74 0.07 0.05 0.74 0.58 0.72
## [57] 0.65 0.01 0.09 0.09 0.06 0.74 0.72 0.79 0.09 0.08 0.72 0.65 0.81 0.66
## [71] 0.66 0.04 0.74 0.65 0.58 0.05 0.61 0.71 0.58 0.71 0.71 0.09 0.73 0.58
## [85] 0.59 0.74 0.74 0.02 0.82 0.66 0.99 0.74 0.73 0.66 1.66 0.58 0.64 0.74
## [99] 0.79 0.58 0.74 0.71 0.04 0.07 1.00 0.01 0.58 0.74 0.65 0.69 0.01 0.64
## [113] 0.67 0.73 0.09 0.60 0.74 0.74 0.74 0.80 0.60 0.60 0.69 0.06 0.01 1.23
## [127] 0.74 0.63 0.82 0.78 0.69 0.58 0.74 0.58 0.78 0.60 0.04 0.61 0.73 0.74
## [141] 0.65 0.74 0.66 0.65 1.00 0.74 0.61 0.02 0.62 0.61 0.08 0.06 0.68 0.02
## [155] 0.07 0.07 0.06 0.62 0.62 0.74 0.69 0.07 0.91 0.02 1.00 0.04 0.70 0.74
## [169] 0.59 0.68 0.09 0.74 0.74 0.05 0.61 0.08 0.68 0.02 0.71 0.61 0.62 0.07
## [183] 0.67 0.63 0.68 0.62 0.74 0.68 0.58 0.07 0.09 0.74 0.74 0.03 0.69 0.58
## [197] 0.60 0.65 0.74 0.81 0.80 0.67 0.58 0.08 0.74 0.62 0.09 0.09 0.04 0.72
## [211] 0.61 0.74 0.74 0.09 0.67 0.74 0.01 0.06 0.60 0.73 0.74 0.04 0.64 0.62
## [225] 0.63 0.58 0.63 0.04 0.58 0.64 0.74 0.07 0.74 0.59 0.61 0.58 0.74 0.03
## [239] 0.66 0.74 0.58 0.71 0.62 0.70 0.59 0.09 0.58 0.86 0.04 0.62 0.05
## [1] ""
## [1] "Potenciais outliers referentes ao atributo residualsugar"
## [1] "Quantidade de potenciais outliers 7"
## [1] ""
## [1] 26.05 31.60 22.60 45.80 31.60 26.05 23.50
## [1] ""
## [1] "Potenciais outliers referentes ao atributo chlorides"
## [1] "Quantidade de potenciais outliers 208"
## [1] ""
## [1] 0.114 0.014 0.074 0.093 0.172 0.171 0.147 0.123 0.083 0.168 0.074
## [12] 0.092 0.075 0.144 0.126 0.115 0.076 0.346 0.076 0.154 0.087 0.096
## [23] 0.160 0.084 0.076 0.169 0.104 0.072 0.093 0.086 0.108 0.009 0.095
## [34] 0.074 0.152 0.212 0.158 0.092 0.079 0.175 0.142 0.077 0.083 0.096
## [45] 0.084 0.185 0.118 0.173 0.170 0.073 0.076 0.167 0.145 0.088 0.201
## [56] 0.117 0.076 0.094 0.200 0.080 0.137 0.168 0.073 0.080 0.105 0.204
## [67] 0.014 0.157 0.150 0.174 0.290 0.076 0.121 0.180 0.152 0.148 0.110
## [78] 0.122 0.084 0.074 0.119 0.133 0.194 0.170 0.094 0.119 0.083 0.098
## [89] 0.102 0.094 0.208 0.099 0.138 0.088 0.117 0.087 0.135 0.176 0.184
## [100] 0.185 0.078 0.142 0.120 0.211 0.157 0.092 0.082 0.086 0.080 0.149
## [111] 0.208 0.119 0.126 0.123 0.156 0.012 0.244 0.076 0.085 0.110 0.074
## [122] 0.239 0.138 0.098 0.110 0.142 0.076 0.072 0.083 0.096 0.121 0.014
## [133] 0.096 0.073 0.147 0.168 0.184 0.117 0.126 0.083 0.074 0.123 0.136
## [144] 0.085 0.137 0.197 0.074 0.075 0.082 0.074 0.094 0.096 0.081 0.108
## [155] 0.079 0.073 0.098 0.112 0.157 0.160 0.079 0.127 0.078 0.201 0.175
## [166] 0.169 0.084 0.123 0.087 0.271 0.089 0.255 0.097 0.096 0.176 0.081
## [177] 0.132 0.079 0.091 0.240 0.217 0.090 0.086 0.127 0.094 0.073 0.086
## [188] 0.076 0.173 0.167 0.179 0.301 0.090 0.209 0.013 0.014 0.197 0.130
## [199] 0.157 0.095 0.085 0.093 0.172 0.186 0.084 0.146 0.080 0.174
## [1] ""
## [1] "Potenciais outliers referentes ao atributo freesulfurdioxide"
## [1] "Quantidade de potenciais outliers 50"
## [1] ""
## [1] 108.0 81.0 85.0 289.0 101.0 128.0 83.0 81.0 98.0 86.0 97.0
## [12] 96.0 86.0 87.0 96.0 87.0 82.5 81.0 122.5 146.5 88.0 82.0
## [23] 81.0 105.0 98.0 98.0 82.0 105.0 81.0 112.0 101.0 83.0 81.0
## [34] 131.0 83.0 108.0 85.0 87.0 95.0 93.0 124.0 138.5 108.0 110.0
## [45] 81.0 118.5 89.0 96.0 87.0 83.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo totalsulfurdioxide"
## [1] "Quantidade de potenciais outliers 19"
## [1] ""
## [1] 440.0 9.0 256.0 260.0 19.0 294.0 307.5 256.0 272.0 259.0 18.0
## [12] 303.0 18.0 313.0 344.0 10.0 366.5 272.0 282.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo density"
## [1] "Quantidade de potenciais outliers 5"
## [1] ""
## [1] 1.00295 1.01030 1.01398 1.01030 1.00295
## [1] ""
## [1] "Potenciais outliers referentes ao atributo pH"
## [1] "Quantidade de potenciais outliers 75"
## [1] ""
## [1] 3.80 3.59 3.57 3.60 3.64 3.63 3.58 2.79 3.82 2.79 3.68 3.65 3.65 3.66
## [15] 3.58 3.69 3.61 3.63 3.60 3.69 3.74 3.59 3.81 3.66 3.63 3.60 3.66 3.60
## [29] 3.57 3.72 2.80 2.77 3.64 3.57 3.63 3.65 3.63 3.59 3.59 3.66 3.68 2.72
## [43] 3.79 3.74 3.75 3.75 3.62 3.59 3.80 2.74 2.79 3.59 3.60 3.61 3.58 3.58
## [57] 3.60 3.57 3.77 3.57 3.58 3.72 3.76 3.65 3.72 3.76 3.60 3.66 3.70 3.61
## [71] 2.80 3.67 3.77 2.80 3.63
## [1] ""
## [1] "Potenciais outliers referentes ao atributo sulphates"
## [1] "Quantidade de potenciais outliers 124"
## [1] ""
## [1] 0.77 0.78 0.78 0.98 0.78 0.79 0.79 0.79 0.86 0.79 0.77 0.82 0.95 0.80
## [15] 0.77 0.79 0.78 0.90 0.88 0.79 0.78 0.78 0.81 0.78 0.78 0.82 0.97 0.78
## [29] 0.78 0.77 0.83 0.81 0.80 0.77 0.88 0.78 0.90 0.79 1.00 0.96 0.82 0.84
## [43] 0.81 0.88 0.82 0.80 0.77 0.98 0.84 0.78 0.79 0.77 0.82 0.88 0.77 0.82
## [57] 0.82 0.98 0.94 0.87 0.82 0.78 0.81 0.79 0.78 0.92 0.82 0.94 0.88 0.88
## [71] 0.79 0.96 0.96 0.77 1.06 0.83 0.85 1.08 0.81 0.95 0.98 0.78 0.79 0.84
## [85] 0.98 0.92 0.80 0.78 0.79 0.90 0.77 0.79 0.86 0.79 0.77 0.82 0.95 0.85
## [99] 0.79 0.77 0.99 0.77 0.95 0.77 0.82 0.77 0.77 0.78 0.89 0.82 0.78 0.80
## [113] 1.01 0.82 0.88 0.85 0.98 0.78 0.79 0.95 0.84 0.87 0.90 0.90
## [1] ""
## [1] "Potenciais outliers referentes ao atributo quality"
## [1] "Quantidade de potenciais outliers 200"
## [1] ""
## [1] 8 8 8 8 8 9 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 3 8 8 8 8
## [36] 8 3 3 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8
## [71] 8 8 3 8 9 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 3 8 8 3 8 8 8 8 8 3
## [106] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 8 8 3
## [141] 8 8 8 8 3 8 8 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9
## [176] 8 3 8 8 8 8 8 8 8 8 8 8 3 3 8 8 8 3 8 8 8 8 3 8 8
## [1] ""
Há valores potenciais de outliers em quase todos os atributos dos vinhos brancos, exceto na concentração de alchool que não apresenta outliers
Para verificar se os valores são realmente outliers, sabendo-se que os vinhos são portugueses, utilizou-se os valores de referência do Instituto da Vinha e do Vinho de Portugal, com as informações presentes no link a seguir: http://www.ivv.gov.pt/np4/89/
## [1] "Sumário da qualidade dos vinhos Brancos considerados como outliers "
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.000 5.000 5.000 5.284 6.000 8.000
## [1] "Sumário da qualidade dos vinhos Brancos sem outliers"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.00 5.00 6.00 5.91 6.00 9.00
## [1] "Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa"
##
## Welch Two Sample t-test
##
## data: VinhosBrancos$quality and VinhosBrancosSemOut$quality
## t = -1.7793, df = 9533.9, p-value = 0.07523
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.067137134 0.003248435
## sample estimates:
## mean of x mean of y
## 5.877909 5.909854
Os vinhos brancos selecionados como outliers não possuíam uma distribuição especial em relação à qualidade e não afetavam a média da qualidade dos vinhos. Deste modo, realizou-se um teste T entre os vinhos brancos sem os outliers e a amostra completa, com 95% de confiança e falhou (p-value = 7,5%). Portanto as amostra possuem médias iguais. Por fim, os outliers foram retirados da amostra e do modelo a ser utilizado para predição.
## fixedacidity volatileacidity citricacid residualsugar
## fixedacidity 1.0000 -0.0351 0.282 0.079
## volatileacidity -0.0351 1.0000 -0.089 0.072
## citricacid 0.2824 -0.0894 1.000 0.077
## residualsugar 0.0789 0.0724 0.077 1.000
## chlorides 0.0095 0.0461 0.128 0.076
## freesulfurdioxide -0.0559 -0.0715 0.091 0.318
## totalsulfurdioxide 0.0732 0.1110 0.102 0.402
## density 0.2602 -0.0013 0.145 0.836
## pH -0.4122 -0.0541 -0.156 -0.200
## sulphates -0.0217 -0.0405 0.053 -0.052
## alcohol -0.1208 0.0896 -0.092 -0.470
## quality -0.1118 -0.1388 -0.043 -0.119
## chlorides freesulfurdioxide totalsulfurdioxide density
## fixedacidity 0.0095 -0.0559 0.073 0.2602
## volatileacidity 0.0461 -0.0715 0.111 -0.0013
## citricacid 0.1279 0.0914 0.102 0.1449
## residualsugar 0.0763 0.3183 0.402 0.8360
## chlorides 1.0000 0.1178 0.184 0.2501
## freesulfurdioxide 0.1178 1.0000 0.614 0.3188
## totalsulfurdioxide 0.1842 0.6139 1.000 0.5421
## density 0.2501 0.3188 0.542 1.0000
## pH -0.0825 -0.0062 0.010 -0.0959
## sulphates -0.0010 0.0473 0.108 0.0566
## alcohol -0.3629 -0.2662 -0.465 -0.8080
## quality -0.2074 0.0081 -0.181 -0.3261
## pH sulphates alcohol quality
## fixedacidity -0.4122 -0.022 -0.121 -0.1118
## volatileacidity -0.0541 -0.040 0.090 -0.1388
## citricacid -0.1562 0.053 -0.092 -0.0431
## residualsugar -0.1995 -0.052 -0.470 -0.1189
## chlorides -0.0825 -0.001 -0.363 -0.2074
## freesulfurdioxide -0.0062 0.047 -0.266 0.0081
## totalsulfurdioxide 0.0103 0.108 -0.465 -0.1813
## density -0.0959 0.057 -0.808 -0.3261
## pH 1.0000 0.163 0.125 0.1063
## sulphates 0.1627 1.000 -0.019 0.0438
## alcohol 0.1246 -0.019 1.000 0.4409
## quality 0.1063 0.044 0.441 1.0000
Pelos gráficos acima, percebe-se:
Gráfico de dispersão do vinho branco entre a densidade e o açucar residual
Pelo gráfico, pode-se notar uma tendência linear entre as duas variáveis pelo formato do gráfico. Neste, pode-se perceber que, normalmente, quanto maior a densidade, maior a quantidade de açucar residual
Aqui traçou-se um gráfico para a quantidade residual de açúcar x qualidade para os vinhos brancos já sem os outliers. Percebe-se que os vinhos brancos de maior qualidade possuem uma concentração de açúcar menor que 20 g/L
## [1] "Variância acumulada para cada componente "
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.38909993 28.2424994 28.24250
## Dim.2 1.58636636 13.2197197 41.46222
## Dim.3 1.26219318 10.5182765 51.98050
## Dim.4 1.12079756 9.3399797 61.32048
## Dim.5 1.00233483 8.3527902 69.67327
## Dim.6 0.95095122 7.9245935 77.59786
## Dim.7 0.74903989 6.2419991 83.83986
## Dim.8 0.73434715 6.1195596 89.95942
## Dim.9 0.57112284 4.7593570 94.71877
## Dim.10 0.34436192 2.8696826 97.58846
## Dim.11 0.27531840 2.2943200 99.88278
## Dim.12 0.01406673 0.1172227 100.00000
## [1] "Percentual que cada componente contribui para explicar a variância "
Analisando-se o PCA do modelo completo sobre vinhos brancos, percebe-se:
Verificando os auto-vetores do primeiro de segundo componentes do PCA
Pelo gráfico de contribuição dos atributos em relação ao PCA, temos:
A partir dessas proximidades entre os auto vetores, e considerando as correlações, será feita uma segunda verificação do uso do PCA nas variáveis totalsulfurdioxide,freesulfurdioxide, density,residualsugar e alcohol
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.05891171 61.1782342 61.17823
## Dim.2 1.00870998 20.1741995 81.35243
## Dim.3 0.54765165 10.9530331 92.30547
## Dim.4 0.34022528 6.8045055 99.10997
## Dim.5 0.04450138 0.8900277 100.00000
Analisando a tabela acima, nota-se que os dois primeiros componentes já contribuem para mais de 80% da variancia da base. Mediante a constatação, criou-se dois novos atributos pca1 e pca2 correspondendo ao primeiro e segundo componentes do PCA. Por fim, os atributos originais foram excluídos do modelo por serem passíveis de substituição sem grandes prejuízos.
## [1] "Histograma do Primeiro Componente"
## [1] "Histograma do Segundo Componente"
# Split em conjuntos de treinamento e teste
set.seed(333)
treinamento <- sample_frac(VinhosBrancosNum, 0.7)
teste <- setdiff(VinhosBrancosNum, treinamento)
# Dados sem a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> treinamento_semPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> teste_semPCA
# Dados com a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> treinamento_comPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> teste_comPCA
# Modelo de regressão linear simples
modelo0 <- lm(quality ~ . ,
data=treinamento_comPCA)
modelo1 <- lm(quality ~ . ,
data=treinamento_semPCA)
measures <- function(x) {
L <- list(npar = length(coef(x)),
dfres = df.residual(x),
nobs = length(fitted(x)),
RMSE = summary(x)$sigma,
R2 = summary(x)$r.squared,
R2adj = summary(x)$adj.r.squared,
PRESS = press(x),
logLik = logLik(x),
AIC = AIC(x),
BIC = BIC(x))
unlist(L)
}
modl <- list(m1 = modelo0,m2=modelo1)
round(t(sapply(modl, measures)), 3)
## npar dfres nobs RMSE R2 R2adj PRESS logLik AIC BIC
## m1 9 3245 3254 0.794 0.166 0.164 2059.332 -3863.631 7747.262 7808.139
## m2 12 3242 3254 0.741 0.275 0.272 1794.333 -3636.296 7298.593 7377.732
# Modelo de regressão linear com o modelo aplicado o PCA
print("Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA")
## [1] "Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA"
result <- testa.modelo(modelo=modelo0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Linear com PCA")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.794633943337489"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Modelo com os dados completos sem transformação via PCA
print("Modelo de regressão linear aplicada sobre o modelo com todos os atributos")
## [1] "Modelo de regressão linear aplicada sobre o modelo com todos os atributos"
result <- testa.modelo(modelo=modelo1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear Completo")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747299468844422"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
##### UTILIZANDO FORWARD,BACKWARD OU BOTH
VinhosBrancosStep <- treinamento_semPCA
modelo.base <- lm(quality ~ fixedacidity,
data=VinhosBrancosStep)
modelo.completo <- lm(quality ~ . ,
data=VinhosBrancosStep)
modelo.medio <- lm(quality ~ fixedacidity+volatileacidity+citricacid+chlorides+pH+sulphates,
data=VinhosBrancosStep)
forward<-step(modelo.base,direction="forward")
## Start: AIC=-952.82
## quality ~ fixedacidity
backward<-step(modelo.completo,direction="backward")
## Start: AIC=-1937.86
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates + totalsulfurdioxide + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - chlorides 1 0.047 1780.7 -1939.8
## - citricacid 1 0.268 1780.9 -1939.4
## - totalsulfurdioxide 1 0.291 1780.9 -1939.3
## <none> 1780.7 -1937.9
## - alcohol 1 7.480 1788.1 -1926.2
## - fixedacidity 1 7.515 1788.2 -1926.2
## - freesulfurdioxide 1 9.352 1790.0 -1922.8
## - sulphates 1 12.070 1792.7 -1917.9
## - pH 1 19.357 1800.0 -1904.7
## - density 1 26.707 1807.4 -1891.4
## - residualsugar 1 40.868 1821.5 -1866.0
## - volatileacidity 1 66.611 1847.3 -1820.3
##
## Step: AIC=-1939.77
## quality ~ fixedacidity + volatileacidity + citricacid + pH +
## sulphates + totalsulfurdioxide + freesulfurdioxide + density +
## residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - citricacid 1 0.244 1780.9 -1941.3
## - totalsulfurdioxide 1 0.282 1781.0 -1941.3
## <none> 1780.7 -1939.8
## - alcohol 1 7.450 1788.2 -1928.2
## - fixedacidity 1 8.073 1788.8 -1927.0
## - freesulfurdioxide 1 9.305 1790.0 -1924.8
## - sulphates 1 12.251 1793.0 -1919.5
## - pH 1 20.328 1801.0 -1904.8
## - density 1 28.081 1808.8 -1890.9
## - residualsugar 1 43.647 1824.3 -1863.0
## - volatileacidity 1 67.510 1848.2 -1820.7
##
## Step: AIC=-1941.33
## quality ~ fixedacidity + volatileacidity + pH + sulphates + totalsulfurdioxide +
## freesulfurdioxide + density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - totalsulfurdioxide 1 0.289 1781.2 -1942.8
## <none> 1780.9 -1941.3
## - alcohol 1 7.698 1788.6 -1929.3
## - fixedacidity 1 8.407 1789.3 -1928.0
## - freesulfurdioxide 1 9.669 1790.6 -1925.7
## - sulphates 1 12.384 1793.3 -1920.8
## - pH 1 20.088 1801.0 -1906.8
## - density 1 27.840 1808.8 -1892.8
## - residualsugar 1 43.403 1824.3 -1865.0
## - volatileacidity 1 68.509 1849.5 -1820.5
##
## Step: AIC=-1942.8
## quality ~ fixedacidity + volatileacidity + pH + sulphates + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## <none> 1781.2 -1942.8
## - alcohol 1 7.427 1788.7 -1931.3
## - fixedacidity 1 8.871 1790.1 -1928.6
## - freesulfurdioxide 1 12.063 1793.3 -1922.8
## - sulphates 1 12.339 1793.6 -1922.3
## - pH 1 20.520 1801.8 -1907.5
## - density 1 32.094 1813.3 -1886.7
## - residualsugar 1 47.688 1828.9 -1858.8
## - volatileacidity 1 74.740 1856.0 -1811.0
stepwise<-step(modelo.medio,direction="both")
## Start: AIC=-1169.81
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates
##
## Df Sum of Sq RSS AIC
## - citricacid 1 1.174 2262.8 -1170.1
## - sulphates 1 1.302 2262.9 -1169.9
## <none> 2261.6 -1169.8
## - pH 1 3.122 2264.7 -1167.3
## - fixedacidity 1 20.597 2282.2 -1142.3
## - volatileacidity 1 45.937 2307.6 -1106.4
## - chlorides 1 96.729 2358.3 -1035.5
##
## Step: AIC=-1170.12
## quality ~ fixedacidity + volatileacidity + chlorides + pH + sulphates
##
## Df Sum of Sq RSS AIC
## <none> 2262.8 -1170.1
## - sulphates 1 1.479 2264.3 -1170.0
## + citricacid 1 1.174 2261.6 -1169.8
## - pH 1 2.940 2265.7 -1167.9
## - fixedacidity 1 19.423 2282.2 -1144.3
## - volatileacidity 1 47.547 2310.3 -1104.5
## - chlorides 1 95.651 2358.4 -1037.4
print("*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****")
## [1] "*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****"
modl <- list(m1 = forward,m2=backward,m3=stepwise)
round(t(sapply(modl, measures)), 3)
## npar dfres nobs RMSE R2 R2adj PRESS logLik AIC BIC
## m1 2 3252 3254 0.864 0.012 0.012 2428.240 -4138.817 8283.634 8301.897
## m2 9 3245 3254 0.741 0.275 0.273 1792.086 -3636.826 7293.653 7354.529
## m3 6 3248 3254 0.835 0.079 0.077 2272.160 -4026.164 8066.327 8108.941
##### TESTE DE PREDIÇÃO DOS MODELOS #######
print("Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=forward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico="Linear com forward")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.864954247314014"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
print("Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=backward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com backward")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747013073135287"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
print("Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos")
## [1] "Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos"
result<-testa.modelo(modelo=stepwise, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com both")
## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.839878291284835"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
##### Testa contra os piores modelos
VinhosBrancosModelosRuins <- VinhosBrancosNum
#Utiliza como
VinhosBrancosModelosRuins$qualidade.media <- mean(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.media
print("Modelo Ruim - retorna sempre a média ")
## [1] "Modelo Ruim - retorna sempre a média "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - Sempre a média")
## [1] "MSE para o modelo---> 0.868162825258606"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
VinhosBrancosModelosRuins$qualidade.max <- max(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.max
print("Modelo Ruim - retorna sempre o máximo ")
## [1] "Modelo Ruim - retorna sempre o máximo "
result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - sempre o máximo")
## [1] "MSE para o modelo---> 3.20978361316982"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
library(rpart)
print("Modelo de Árvore de regressão com aplicação de PCA - atributos retirados")
## [1] "Modelo de Árvore de regressão com aplicação de PCA - atributos retirados"
result<-testa.modelo(modelo=modelo_Valor_tree0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Árvore de Regressão com PCA", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 341 obs. of 8 variables:
## ..$ var : Factor w/ 9 levels "<leaf>","chlorides",..: 5 9 2 9 7 8 6 5 7 1 ...
## ..$ n : int [1:341] 3254 2197 1412 1073 560 435 425 157 13 4 ...
## ..$ wt : num [1:341] 3254 2197 1412 1073 560 ...
## ..$ dev : num [1:341] 2456 1369 759 502 218 ...
## ..$ yval : num [1:341] 5.91 5.74 5.56 5.46 5.33 ...
## ..$ complexity: num [1:341] 0.08662 0.04776 0.02123 0.00729 0.0026 ...
## ..$ ncompete : int [1:341] 4 4 4 4 4 4 4 4 4 0 ...
## ..$ nsurrogate: int [1:341] 5 5 5 5 2 0 5 2 3 0 ...
## $ where : Named int [1:3254] 269 88 205 311 36 206 110 14 281 328 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_comPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2)
## .. ..- attr(*, "factors")= int [1:9, 1:8] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:8] 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2)
## .. ..- attr(*, "dataClasses")= Named chr [1:9] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:128, 1:5] 0.0866 0.0558 0.0478 0.0212 0.0118 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:128] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1304, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1304] "pca1" "chlorides" "pca2" "citricacid" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:8] 475 377 275 254 200 ...
## ..- attr(*, "names")= chr [1:8] "pca1" "pca2" "chlorides" "volatileacidity" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:8] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.860193041488428"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
library(rpart)
print("Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA")
## [1] "Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA"
result<-testa.modelo(modelo=modelo_Valor_tree1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Árvore de Regressão completa", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 311 obs. of 8 variables:
## ..$ var : Factor w/ 12 levels "<leaf>","alcohol",..: 2 12 2 7 11 1 1 4 10 6 ...
## ..$ n : int [1:311] 3254 2065 1064 837 59 37 22 778 182 121 ...
## ..$ wt : num [1:311] 3254 2065 1064 837 59 ...
## ..$ dev : num [1:311] 2455.6 1189.1 463.4 290.2 22.2 ...
## ..$ yval : num [1:311] 5.91 5.64 5.39 5.32 4.88 ...
## ..$ complexity: num [1:311] 0.17476 0.05444 0.00801 0.00498 0.00171 ...
## ..$ ncompete : int [1:311] 4 4 4 4 4 0 0 4 4 4 ...
## ..$ nsurrogate: int [1:311] 5 5 5 2 5 0 0 5 5 0 ...
## $ where : Named int [1:3254] 236 129 54 223 60 114 81 6 305 284 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_semPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide + fr| __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:12, 1:11] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:11] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:12] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:110, 1:5] 0.1748 0.0544 0.0281 0.0165 0.0112 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:110] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1314, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1314] "alcohol" "density" "chlorides" "totalsulfurdioxide" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:11] 629 503 273 269 259 ...
## ..- attr(*, "names")= chr [1:11] "alcohol" "density" "totalsulfurdioxide" "chlorides" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:11] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.830208896967626"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Regressão Logística
treinamento_comPCA %>%
mutate(quality_rel = quality/10) -> treinamento_comPCA_rel
treinamento_comPCA$quality <- NULL
treinamento_semPCA %>%
mutate(quality_rel = quality/10) -> treinamento_semPCA_rel
treinamento_semPCA$quality <- NULL
teste_comPCA %>%
mutate(quality_rel = quality/10) -> teste_comPCA_rel
teste_comPCA$quality <- NULL
teste_semPCA %>%
mutate(quality_rel = quality/10) -> teste_semPCA_rel
teste_semPCA$quality <- NULL
# Regressão Logística com a aplicação do PCA
modelo_logistica0 <- glm(quality_rel ~ . ,
family = binomial(link = 'logit'),
data = treinamento_comPCA_rel)
print("Modelo de Regressão Logística com aplicação de PCA - atributos retirados")
## [1] "Modelo de Regressão Logística com aplicação de PCA - atributos retirados"
result<-testa.modelo(modelo=modelo_logistica0, dataset=teste_comPCA_rel, valores_observados=teste_comPCA_rel$quality_rel, tit_grafico = "Regressão Logística com PCA", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 30
## $ coefficients : Named num [1:10] -2.190683 0.000932 0.03144 -0.001623 0.0073 ...
## ..- attr(*, "names")= chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ residuals : Named num [1:3254] 0.000116 -0.003817 0.007515 -0.016336 0.00977 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ fitted.values : Named num [1:3254] 0.7 0.701 0.498 0.604 0.498 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ effects : Named num [1:3254] -9.8346 -1.0663 1.5379 -0.0672 1.9127 ...
## ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ R : num [1:10, 1:10] -27.6 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ rank : int 10
## $ qr :List of 5
## ..$ qr : num [1:3254, 1:10] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
## .. .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## ..$ rank : int 10
## ..$ qraux: num [1:10] 1.02 1.02 1.02 1.02 1.01 ...
## ..$ pivot: int [1:10] 1 2 3 4 5 6 7 8 9 10
## ..$ tol : num 1e-11
## ..- attr(*, "class")= chr "qr"
## $ family :List of 12
## ..$ family : chr "binomial"
## ..$ link : chr "logit"
## ..$ linkfun :function (mu)
## ..$ linkinv :function (eta)
## ..$ variance :function (mu)
## ..$ dev.resids:function (y, mu, wt)
## ..$ aic :function (y, n, mu, wt, dev)
## ..$ mu.eta :function (eta)
## ..$ initialize: expression({ if (NCOL(y) == 1) { if (is.factor(y)) y <- y != levels(y)[1L] n <- rep.int(1, nobs) y[weights =| __truncated__
## ..$ validmu :function (mu)
## ..$ valideta :function (eta)
## ..$ simulate :function (object, nsim)
## ..- attr(*, "class")= chr "family"
## $ linear.predictors: Named num [1:3254] 0.84718 0.85111 -0.00751 0.42177 -0.00977 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ deviance : num 0.436
## $ aic : num 3402
## $ null.deviance : num 104
## $ iter : int 4
## $ weights : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ prior.weights : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ df.residual : int 3244
## $ df.null : int 3253
## $ y : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ converged : logi TRUE
## $ boundary : logi FALSE
## $ model :'data.frame': 3254 obs. of 10 variables:
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ pca1 : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
## ..$ pca2 : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "terms")=Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + quality
## .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. .. ..- attr(*, "intercept")= int 1
## .. .. ..- attr(*, "response")= int 1
## .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ call : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"), data = treinamento_comPCA_rel)
## $ formula :Class 'formula' language quality_rel ~ .
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## $ terms :Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + quality
## .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ data :'data.frame': 3254 obs. of 10 variables:
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ pca1 : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
## ..$ pca2 : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## $ offset : NULL
## $ control :List of 3
## ..$ epsilon: num 1e-08
## ..$ maxit : num 25
## ..$ trace : logi FALSE
## $ method : chr "glm.fit"
## $ contrasts : NULL
## $ xlevels : Named list()
## - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365047384034817"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Regressão Logística sem a aplicação de PCA
modelo_logistica1 <- glm(quality_rel ~ . ,
family = binomial(link = 'logit'),
data = treinamento_semPCA_rel)
print("Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA")
## [1] "Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA"
result<-testa.modelo(modelo=modelo_logistica1, dataset=teste_semPCA_rel, valores_observados=teste_semPCA_rel$quality_rel, tit_grafico = "Regressão Logística completa", sumario=FALSE)
## [1] "Sumário do modelo...."
## List of 30
## $ coefficients : Named num [1:13] -2.421499 0.000672 0.033491 -0.001266 -0.006122 ...
## ..- attr(*, "names")= chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ residuals : Named num [1:3254] 0.000287 -0.005205 0.00676 -0.016403 0.010866 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ fitted.values : Named num [1:3254] 0.7 0.701 0.498 0.604 0.497 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ effects : Named num [1:3254] -9.8346 -1.0664 1.5375 -0.0671 1.9128 ...
## ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ R : num [1:13, 1:13] -27.6 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ rank : int 13
## $ qr :List of 5
## ..$ qr : num [1:3254, 1:13] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
## .. .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## ..$ rank : int 13
## ..$ qraux: num [1:13] 1.02 1.02 1.02 1.02 1.01 ...
## ..$ pivot: int [1:13] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ tol : num 1e-11
## ..- attr(*, "class")= chr "qr"
## $ family :List of 12
## ..$ family : chr "binomial"
## ..$ link : chr "logit"
## ..$ linkfun :function (mu)
## ..$ linkinv :function (eta)
## ..$ variance :function (mu)
## ..$ dev.resids:function (y, mu, wt)
## ..$ aic :function (y, n, mu, wt, dev)
## ..$ mu.eta :function (eta)
## ..$ initialize: expression({ if (NCOL(y) == 1) { if (is.factor(y)) y <- y != levels(y)[1L] n <- rep.int(1, nobs) y[weights =| __truncated__
## ..$ validmu :function (mu)
## ..$ valideta :function (eta)
## ..$ simulate :function (object, nsim)
## ..- attr(*, "class")= chr "family"
## $ linear.predictors: Named num [1:3254] 0.84701 0.8525 -0.00676 0.42184 -0.01087 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ deviance : num 0.435
## $ aic : num 3409
## $ null.deviance : num 104
## $ iter : int 4
## $ weights : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ prior.weights : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ df.residual : int 3241
## $ df.null : int 3253
## $ y : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ converged : logi TRUE
## $ boundary : logi FALSE
## $ model :'data.frame': 3254 obs. of 13 variables:
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
## ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
## ..$ density : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
## ..$ residualsugar : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
## ..$ alcohol : num [1:3254] 12 10 10.4 11.5 10.6 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "terms")=Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide | __truncated__ ...
## .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
## .. .. ..- attr(*, "intercept")= int 1
## .. .. ..- attr(*, "response")= int 1
## .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
## .. .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ call : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"), data = treinamento_semPCA_rel)
## $ formula :Class 'formula' language quality_rel ~ .
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## $ terms :Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide | __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ data :'data.frame': 3254 obs. of 13 variables:
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
## ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
## ..$ density : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
## ..$ residualsugar : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
## ..$ alcohol : num [1:3254] 12 10 10.4 11.5 10.6 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## $ offset : NULL
## $ control :List of 3
## ..$ epsilon: num 1e-08
## ..$ maxit : num 25
## ..$ trace : logi FALSE
## $ method : chr "glm.fit"
## $ contrasts : NULL
## $ xlevels : Named list()
## - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365071067344587"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol) -> NS_treinamento_semPCA
# Dados com a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2) -> NS_treinamento_comPCA
kmeans_semPCA <- kmeans(NS_treinamento_semPCA, 7)
kmeans_comPCA <- kmeans(NS_treinamento_comPCA, 7)
print("Quantidade de amostras por qualidade")
## [1] "Quantidade de amostras por qualidade"
table(treinamento$quality)
##
## 3 4 5 6 7 8 9
## 8 85 947 1482 609 119 4
print("")
## [1] ""
print("Quantidade de amostras por cluster sem PCA")
## [1] "Quantidade de amostras por cluster sem PCA"
kmeans_semPCA$size
## [1] 494 771 455 257 649 259 369
print("")
## [1] ""
print("Quantidade de amostras por cluster com PCA")
## [1] "Quantidade de amostras por cluster com PCA"
kmeans_comPCA$size
## [1] 662 502 420 475 352 462 381
print("")
## [1] ""